COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Chart Making program for TEX output
C00004 00003	 The lines of a box are segments. So a Box would look like:
C00019 ENDMK
C⊗;
;;; Chart Making program for TEX output
;;; You can set *normalize* to self-normalize a chart
;;; or *global-normalize* to normalize over all benchmarks
;;;	(...(benchmark 
;;;	     (impl1 entry1) (impl2 entry2)...) ...)
;;;
;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations*))
(sstatus syntax #o45 (status syntax #o40))

(defun lookup (bench impl)
       (cadr (assoc impl (cdr (assoc bench *data*)))))

(declare (special *benchmark-info*))

(defun get-bench-info (bench)
       (cdr (assoc bench *benchmark-info*)))

(defmacro trunc (x)
	  `(//$ 
	    (float 
	     (fix 
	      (times 100.0 ,x))) 100.0))

(defun tsafe-quotient (x y)
       (cond ((and (numberp x)
		   (numberp y))
	      (cond ((and (zerop x)(zerop y))
		     1.0)
		    ((zerop y) '"$\infty$")
		    (t (round (quotient x y)))))))

;;; The lines of a box are segments. So a Box would look like:
;;;	<blankline>
;;;	Division by 2
;;;	<blankline>
;;;	   Recursive
;;;	   Iterative
;;;	<blankline>

(declare (mapex t) (special *normalize* *global-normalize*))

(setq *normalize* t)
(setq *global-normalize* ())

(defun make-a-chart (implementations)
       (make-top-row implementations)
       (mapc #'(lambda (bench)
		       (make-a-row bench implementations))
	     *benchmarks*)
       t)

(defun make-top-row (implementations)
       (make-a-row 'Title implementations))

(defun make-a-row (bench implementations)
 (let  ((info
	 (get-bench-info bench)))
       (do ((info info (cdr info)))
	   ((null info))
	   (terpri)
	   (princ "&&")
	   (princ (caar info))
	   (cond 
	    ((eq bench 'title)
	     (do ((impls implementations (cdr impls)))
		 ((null impls)
		  (princ "&\cr\tablerule")
		  (terpri))
		 (princ "&&")
		 (princ "{\bf ")
		 (princ (lookup 'title (car impls)))
		 (princ "}")
		 ))
	    ((null (cadr (car info)))
	     (do ((impls implementations (cdr impls)))
		 ((null impls)
		  (princ "&\cr")(terpri))
		 (princ "&&")))
	    (t (let* ((fun (cadr (cadr (car info))))
		      (entries
		       (mapcar
			#'(lambda (impl)
				  (let ((entry (lookup bench impl)))
				       (cond (entry
					      (funcall fun impl entry)))))
			implementations)))
		     (cond (*normalize*
			    (let ((best (car entries)))
				 (cond (*global-normalize*
					(let ((all-entries
					       (mapcar
						#'(lambda (impl)
							  (let ((entry (lookup bench (car impl))))
							       (cond (entry
								      (funcall fun (car impl) entry)))))
						*all-implementations*)))
					     (do ((entries (cdr all-entries) (cdr entries)))
						 ((null entries))
						 (cond ((and (numberp 
							      (car entries))
							     (numberp best)
							     (lessp (car entries) 
								    best))
							(setq best (car entries)))))))
				       (t					
					(do ((entries (cdr entries) (cdr entries)))
					    ((null entries))
					    (cond ((and (numberp 
							 (car entries))
							(numberp best)
							(lessp (car entries) 
							       best))
						   (setq best (car entries)))))))
				 (cond ((not (zerop best))
					(setq entries
					      (mapcar 
					       #'(lambda (x)
							 (cond 
							  ((not (numberp x))
							   x)
							  (t 
							   (tsafe-quotient 
							    x best))))
					       entries)))))))
		     (do ((entries entries (cdr entries)))
			 ((null entries)
			  (cond ((cdr info)
				 (princ "&\cr"))
				(t (princ "&\cr\tablerule")))
			  (terpri))
			 (princ "&&")
			 (cond ((null (car entries))
				(princ "$-$"))
			       (t (princ (car entries)))))))))))

(defun do-tchart-cpu (implementations)
       (treport-cpu)
       (do-tchart1 implementations 'cpu))

(defun do-tchart1 (implementations type)
       (let ((n (length implementations)))
	    (terpri)
	    (princ "\newbox\bigstrutbox")
	    (terpri)
	    (princ "\setbox\bigstrutbox=\hbox{\vrule height10pt depth5.0pt width0pt}")
	    (terpri)
	    (princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
	    (terpri)
	    (princ "\vbox{\tabskip=0pt \offinterlineskip")
	    (terpri)
	    (princ "\def\tablerule{\noalign{\hrule}}")
	    (terpri)
	    (princ "\halign{\bigstrut#& \vrule#\tabskip=1em plus2em&#& \vrule#&")
	    (do ((i (1- n) (1- i)))
		((zerop i)
		 (princ "\hfil#\hfil& \vrule#\tabskip=0pt\cr\tablerule")
		 (terpri)
		 (princ "&&\multispan{")(princ (1+ (* n 2)))
		 (let ((mess (cond ((eq type 'cpu)
				    "{\bf CPU Time}")
				   (t "{\bf Real Time}"))))
		      (princ "}\hfil ")
		      (princ mess)
		      (cond (*global-normalize* 
			     (setq *normalize* t)
			     (princ " (Globally Normalized)") )
			    (*normalize*
			     (princ " (Normalized)")))
		      (princ "\hfil&\cr\tablerule"))
		 )
		(princ "\hfil#\hfil& \vrule#&")(terpri))
       (make-a-chart
	implementations) 
       (princ "}}")))

(defun do-tchart-real (implementations)
       (treport-real)
       (do-tchart1 implementations 'real))